home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 1
/
Cream of the Crop 1.iso
/
PROGRAM
/
VS_804.ARJ
/
MAINTSRC.EXE
/
C_DBF.PRG
< prev
next >
Wrap
Text File
|
1991-10-30
|
4KB
|
188 lines
* Filename......: C_Dbf.Prg
*
* Author........: Vernon E. Six, Jr.
*
* Last Update...: Wed 10-30-1991 13:48:45
*
* Notice........: Copyright (c) 1991 by Vernon E. Six, Jr.
* All Rights Reserved World Wide
*
* Dialect.......: Clipper v5.0x
#include "INKEY.CH"
#include "SETCURS.CH"
FUNCTION C_Dbf()
*****
* Copy a database
*****
LOCAL a_Temp := {}
LOCAL a_Struct := {}
LOCAL ac_Ntx := {}
LOCAL c_CurrDbf := _DICTHDR->DBF_NAME
LOCAL a_Values := {}
LOCAL n_Cntr
LOCAL n_Cntr2
LOCAL c_NewDbf
*****
* Get the new database's name
*****
IF EMPTY( a_Temp := A_DictHdr(.F.) )
RETURN(NIL)
ELSE
c_NewDbf = a_Temp[1]
ENDIF
BEGIN SEQUENCE
*══ Header ════════════════════════════════════════════════*
a_Values := {}
IF .NOT. _DICTHDR->( dbSeek( c_CurrDbf ) )
BREAK
ENDIF
*****
* Get all the header information (let's be generic!!!)
*****
FOR n_Cntr = 1 TO _DICTHDR->( FCount() )
AADD( a_Values, _DICTHDR->( FieldGet(n_Cntr) ) )
IF ALLTRIM( _DICTHDR->( FieldName(n_Cntr) ) ) == "DBF_NAME"
a_Values[n_Cntr] = c_NewDbf
ENDIF
NEXT n_Cntr
*****
* Create the new record
*****
IF .NOT. _DICTHDR->( VS_AddRec() )
BREAK
ENDIF
FOR n_Cntr = 1 TO LEN( a_Values )
_DICTHDR->( FieldPut( n_Cntr, a_Values[n_Cntr] ) )
NEXT n_Cntr
*══ Fields ════════════════════════════════════════════════*
*****
* Get the structure
*****
_DICTFLD->( dbSeek( c_CurrDbf ) )
a_Struct := {}
DO WHILE .NOT. _DICTFLD->( EOF() )
IF _DICTFLD->DBF_NAME <> c_CurrDbf
EXIT
ENDIF
a_Values := {}
FOR n_Cntr = 1 TO _DICTFLD->( FCount() )
AADD( a_Values, _DICTFLD->( FieldGet(n_Cntr) ) )
IF ALLTRIM( _DICTFLD->( FieldName(n_Cntr) ) ) == "DBF_NAME"
a_Values[n_Cntr] = c_NewDbf
ENDIF
NEXT n_Cntr
AADD( a_Struct, a_Values )
_DICTFLD->( dbSkip() )
ENDDO
*****
* Create the new records
*****
FOR n_Cntr = 1 TO LEN( a_Struct )
IF .NOT. _DICTFLD->( VS_AddRec() )
BREAK
ENDIF
a_Values = a_Struct[n_Cntr]
FOR n_Cntr2 = 1 TO LEN( a_Values )
_DICTFLD->( FieldPut( n_Cntr2, a_Values[n_Cntr2] ) )
NEXT n_Cntr2
NEXT n_Cntr
*══ Indices ═══════════════════════════════════════════════*
*****
* Get the structure
*****
_DICTNTX->( dbSeek( c_CurrDbf ) )
a_Struct := {}
DO WHILE .NOT. _DICTNTX->( EOF() )
IF _DICTNTX->DBF_NAME <> c_CurrDbf
EXIT
ENDIF
a_Values := {}
FOR n_Cntr = 1 TO _DICTNTX->( FCount() )
AADD( a_Values, _DICTNTX->( FieldGet(n_Cntr) ) )
IF ALLTRIM( _DICTNTX->( FieldName(n_Cntr) ) ) == "DBF_NAME"
a_Values[n_Cntr] = c_NewDbf
ENDIF
NEXT n_Cntr
AADD( a_Struct, a_Values )
_DICTNTX->( dbSkip() )
ENDDO
*****
* Create the new records
*****
FOR n_Cntr = 1 TO LEN( a_Struct )
IF .NOT. _DICTNTX->( VS_AddRec() )
BREAK
ENDIF
a_Values = a_Struct[n_Cntr]
FOR n_Cntr2 = 1 TO LEN( a_Values )
_DICTNTX->( FieldPut( n_Cntr2, a_Values[n_Cntr2] ) )
NEXT n_Cntr2
NEXT n_Cntr
*══════════════════════════════════════════════════════════*
END SEQUENCE
dbUnlockAll()
RETURN(NIL)
*** EOF: C_Dbf() ************************************************************